home *** CD-ROM | disk | FTP | other *** search
- /* sorupd.f -- translated by f2c (version of 3 February 1990 3:36:42).
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
- */
-
- #include "f2c.h"
-
- /* Common Block Declarations */
-
- struct {
- integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens,
- nsens, ifour, nfour, ifield, icode, idelim, icolum, insize,
- junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr,
- numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap,
- iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3,
- lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod,
- nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf,
- irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar,
- lvntmp;
- } tabinf_;
-
- #define tabinf_1 tabinf_
-
- struct {
- integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt,
- nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
- } cirdat_;
-
- #define cirdat_1 cirdat_
-
- struct {
- doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu,
- sfactr;
- integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno,
- itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
- } status_;
-
- #define status_1 status_
-
- struct {
- integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod,
- lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
- } flags_;
-
- #define flags_1 flags_
-
- struct {
- doublereal value[200000];
- } blank_;
-
- #define blank_1 blank_
-
- /* Table of constant values */
-
- static integer c__1 = 1;
-
- /*< subroutine sorupd >*/
- /* Subroutine */ int sorupd_()
- {
- /* Format strings */
- static char fmt_901[] = "(\0020*abort*: internal spice error: sorupd: \
- \002,2i5/)";
-
- /* Builtin functions */
- double sin(), exp();
- integer s_wsfe(), do_fio(), e_wsfe();
-
- /* Local variables */
- static doublereal omeg;
- static integer locp, locv, iknt;
- static doublereal xmod, dt1t2, dt1t3, dt2t3, time1, omegc, theta, omegs;
- static integer icntr, itype, numtd, l1, l2, l3;
- static doublereal t1, t2, v1, v2, t3, t4, tfact1, tfact2, tfact3, tdnom1,
- tdnom2, tdnom3;
- static integer id;
- static doublereal td, baktim;
- #define nodplc ((integer *)&blank_1)
- #define cvalue ((complex *)&blank_1)
- static doublereal period;
- extern /* Subroutine */ int sizmem_();
- static integer ltdsiz, ltdptr, loc;
- static doublereal tau1, tau2, dtt1, dtt2, dtt3;
-
- /* Fortran I/O blocks */
- static cilist io__45 = { 0, 0, 0, fmt_901, 0 };
-
-
- /*< implicit double precision (a-h,o-z) >*/
-
- /* this routine updates the independent voltage and current sources */
-
- /* used in the circuit. it also updates the ltd table (which contains */
- /* previous (delayed) values of the sources used to model transmission */
- /* lines). */
-
- /* spice version 2g.6 sccsid=tabinf 3/15/83 */
- /*< common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
- /*< 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
- /*< 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
- /*< 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
- /*< 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
- /*< 5 imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
- /*< 6 loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
- /*< 7 irowno,jcolno,nttbr,nttar,lvntmp >*/
- /* spice version 2g.6 sccsid=cirdat 3/15/83 */
- /*< common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
- /*< 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
- /* spice version 2g.6 sccsid=status 3/15/83 */
- /*< common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
- /*< 1 xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
- /*< 2 iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
- /* spice version 2g.6 sccsid=flags 3/15/83 */
- /*< common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
- /*< 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
- /* spice version 2g.6 sccsid=blank 3/15/83 */
- /*< common /blank/ value(200000) >*/
- /*< integer nodplc(64) >*/
- /*< complex cvalue(32) >*/
- /*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
-
-
- /*< do 500 id=9,10 >*/
- for (id = 9; id <= 10; ++id) {
- /*< loc=locate(id) >*/
- loc = cirdat_1.locate[id - 1];
- /*< 10 if (loc.eq.0) go to 500 >*/
- L10:
- if (loc == 0) {
- goto L500;
- }
- /*< if ((id.eq.9).and.(nodplc(loc+11).ne.0)) go to 500 >*/
- if (id == 9 && nodplc[loc + 10] != 0) {
- goto L500;
- }
- /*< if ((id.eq.10).and.(nodplc(loc+6).ne.0)) go to 500 >*/
- if (id == 10 && nodplc[loc + 5] != 0) {
- goto L500;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< locp=nodplc(loc+5) >*/
- locp = nodplc[loc + 4];
- /*< itype=nodplc(loc+4)+1 >*/
- itype = nodplc[loc + 3] + 1;
- /*< go to (490,100,200,300,400,450), itype >*/
- switch (itype) {
- case 1: goto L490;
- case 2: goto L100;
- case 3: goto L200;
- case 4: goto L300;
- case 5: goto L400;
- case 6: goto L450;
- }
-
- /* pulse source */
-
- /*< 100 v1=value(locp+1) >*/
- L100:
- v1 = blank_1.value[locp];
- /*< v2=value(locp+2) >*/
- v2 = blank_1.value[locp + 1];
- /*< t1=value(locp+3) >*/
- t1 = blank_1.value[locp + 2];
- /*< t2=value(locp+4) >*/
- t2 = blank_1.value[locp + 3];
- /*< t3=value(locp+5) >*/
- t3 = blank_1.value[locp + 4];
- /*< t4=value(locp+6) >*/
- t4 = blank_1.value[locp + 5];
- /*< period=value(locp+7) >*/
- period = blank_1.value[locp + 6];
- /*< time1=time >*/
- time1 = status_1.time;
- /*< if (time1.le.0.0d0) go to 160 >*/
- if (time1 <= 0.) {
- goto L160;
- }
- /*< 110 if (time1.lt.t1+period) go to 120 >*/
- L110:
- if (time1 < t1 + period) {
- goto L120;
- }
- /*< time1=time1-period >*/
- time1 -= period;
- /*< go to 110 >*/
- goto L110;
- /*< 120 if (time1.lt.t4) go to 130 >*/
- L120:
- if (time1 < t4) {
- goto L130;
- }
- /*< value(locv+1)=v1 >*/
- blank_1.value[locv] = v1;
- /*< go to 490 >*/
- goto L490;
- /*< 130 if (time1.lt.t3) go to 140 >*/
- L130:
- if (time1 < t3) {
- goto L140;
- }
- /*< value(locv+1)=v2+(time1-t3)*(v1-v2)/(t4-t3) >*/
- blank_1.value[locv] = v2 + (time1 - t3) * (v1 - v2) / (t4 - t3);
- /*< go to 490 >*/
- goto L490;
- /*< 140 if (time1.lt.t2) go to 150 >*/
- L140:
- if (time1 < t2) {
- goto L150;
- }
- /*< value(locv+1)=v2 >*/
- blank_1.value[locv] = v2;
- /*< go to 490 >*/
- goto L490;
- /*< 150 if (time1.lt.t1) go to 160 >*/
- L150:
- if (time1 < t1) {
- goto L160;
- }
- /*< value(locv+1)=v1+(time1-t1)*(v2-v1)/(t2-t1) >*/
- blank_1.value[locv] = v1 + (time1 - t1) * (v2 - v1) / (t2 - t1);
- /*< go to 490 >*/
- goto L490;
- /*< 160 value(locv+1)=v1 >*/
- L160:
- blank_1.value[locv] = v1;
- /*< go to 490 >*/
- goto L490;
-
- /* sinusoidal source */
-
- /*< 200 v1=value(locp+1) >*/
- L200:
- v1 = blank_1.value[locp];
- /*< v2=value(locp+2) >*/
- v2 = blank_1.value[locp + 1];
- /*< omeg=value(locp+3) >*/
- omeg = blank_1.value[locp + 2];
- /*< t1=value(locp+4) >*/
- t1 = blank_1.value[locp + 3];
- /*< theta=value(locp+5) >*/
- theta = blank_1.value[locp + 4];
- /*< time1=time-t1 >*/
- time1 = status_1.time - t1;
- /*< if (time1.gt.0.0d0) go to 210 >*/
- if (time1 > 0.) {
- goto L210;
- }
- /*< value(locv+1)=v1 >*/
- blank_1.value[locv] = v1;
- /*< go to 490 >*/
- goto L490;
- /*< 210 if (theta.ne.0.0d0) go to 220 >*/
- L210:
- if (theta != 0.) {
- goto L220;
- }
- /*< value(locv+1)=v1+v2*dsin(omeg*time1) >*/
- blank_1.value[locv] = v1 + v2 * sin(omeg * time1);
- /*< go to 490 >*/
- goto L490;
- /*< 220 value(locv+1)=v1+v2*dsin(omeg*time1)*dexp(-time1*theta) >*/
- L220:
- blank_1.value[locv] = v1 + v2 * sin(omeg * time1) * exp(-time1 *
- theta);
- /*< go to 490 >*/
- goto L490;
-
- /* exponential source */
-
- /*< 300 v1=value(locp+1) >*/
- L300:
- v1 = blank_1.value[locp];
- /*< v2=value(locp+2) >*/
- v2 = blank_1.value[locp + 1];
- /*< t1=value(locp+3) >*/
- t1 = blank_1.value[locp + 2];
- /*< tau1=value(locp+4) >*/
- tau1 = blank_1.value[locp + 3];
- /*< t2=value(locp+5) >*/
- t2 = blank_1.value[locp + 4];
- /*< tau2=value(locp+6) >*/
- tau2 = blank_1.value[locp + 5];
- /*< time1=time >*/
- time1 = status_1.time;
- /*< if (time1.gt.t1) go to 310 >*/
- if (time1 > t1) {
- goto L310;
- }
- /*< value(locv+1)=v1 >*/
- blank_1.value[locv] = v1;
- /*< go to 490 >*/
- goto L490;
- /*< 310 if (time1.gt.t2) go to 320 >*/
- L310:
- if (time1 > t2) {
- goto L320;
- }
- /*< value(locv+1)=v1+(v2-v1)*(1.0d0-dexp((t1-time1)/tau1)) >*/
- blank_1.value[locv] = v1 + (v2 - v1) * (1. - exp((t1 - time1) / tau1))
- ;
- /*< go to 490 >*/
- goto L490;
- /*< 320 value(locv+1)=v1+(v2-v1)*(1.0d0-dexp((t1-time1)/tau1)) >*/
- /*< 1 +(v1-v2)*(1.0d0-dexp((t2-time1)/tau2)) >*/
- L320:
- blank_1.value[locv] = v1 + (v2 - v1) * (1. - exp((t1 - time1) / tau1))
- + (v1 - v2) * (1. - exp((t2 - time1) / tau2));
- /*< go to 490 >*/
- goto L490;
-
- /* piecewise-linear source */
-
- /*< 400 t1=value(locp+1) >*/
- L400:
- t1 = blank_1.value[locp];
- /*< v1=value(locp+2) >*/
- v1 = blank_1.value[locp + 1];
- /*< t2=value(locp+3) >*/
- t2 = blank_1.value[locp + 2];
- /*< v2=value(locp+4) >*/
- v2 = blank_1.value[locp + 3];
- /*< iknt=4 >*/
- iknt = 4;
- /*< 410 if (time.le.t2) go to 420 >*/
- L410:
- if (status_1.time <= t2) {
- goto L420;
- }
- /*< t1=t2 >*/
- t1 = t2;
- /*< v1=v2 >*/
- v1 = v2;
- /*< t2=value(locp+iknt+1) >*/
- t2 = blank_1.value[locp + iknt];
- /*< v2=value(locp+iknt+2) >*/
- v2 = blank_1.value[locp + iknt + 1];
- /*< iknt=iknt+2 >*/
- iknt += 2;
- /*< go to 410 >*/
- goto L410;
- /*< 420 value(locv+1)=v1+((time-t1)/(t2-t1))*(v2-v1) >*/
- L420:
- blank_1.value[locv] = v1 + (status_1.time - t1) / (t2 - t1) * (v2 -
- v1);
- /*< go to 490 >*/
- goto L490;
-
- /* single-frequency fm */
-
- /*< 450 v1=value(locp+1) >*/
- L450:
- v1 = blank_1.value[locp];
- /*< v2=value(locp+2) >*/
- v2 = blank_1.value[locp + 1];
- /*< omegc=value(locp+3) >*/
- omegc = blank_1.value[locp + 2];
- /*< xmod=value(locp+4) >*/
- xmod = blank_1.value[locp + 3];
- /*< omegs=value(locp+5) >*/
- omegs = blank_1.value[locp + 4];
- /*< value(locv+1)=v1+v2*dsin(omegc*time+xmod*dsin(omegs*time)) >*/
- blank_1.value[locv] = v1 + v2 * sin(omegc * status_1.time + xmod *
- sin(omegs * status_1.time));
- /*< 490 loc=nodplc(loc) >*/
- L490:
- loc = nodplc[loc - 1];
- /*< go to 10 >*/
- goto L10;
- /*< 500 continue >*/
- L500:
- ;}
-
- /* update transmission line sources */
-
- /*< if (jelcnt(17).eq.0) go to 1000 >*/
- if (cirdat_1.jelcnt[16] == 0) {
- goto L1000;
- }
- /*< if (mode.ne.2) go to 1000 >*/
- if (status_1.mode != 2) {
- goto L1000;
- }
- /*< call sizmem(ltd,ltdsiz) >*/
- sizmem_(&tabinf_1.ltd, <dsiz);
- /*< numtd=ltdsiz/ntlin >*/
- numtd = ltdsiz / cirdat_1.ntlin;
- /*< if (numtd.lt.3) go to 900 >*/
- if (numtd < 3) {
- goto L900;
- }
- /*< loc=locate(17) >*/
- loc = cirdat_1.locate[16];
- /*< 610 if (loc.eq.0) go to 1000 >*/
- L610:
- if (loc == 0) {
- goto L1000;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< td=value(locv+2) >*/
- td = blank_1.value[locv + 1];
- /*< baktim=time-td >*/
- baktim = status_1.time - td;
- /*< if (baktim.lt.0.0d0) go to 640 >*/
- if (baktim < 0.) {
- goto L640;
- }
- /*< ltdptr=nodplc(loc+30) >*/
- ltdptr = nodplc[loc + 29];
- /*< icntr=2 >*/
- icntr = 2;
- /*< l1=ltd >*/
- l1 = tabinf_1.ltd;
- /*< l2=l1+ntlin >*/
- l2 = l1 + cirdat_1.ntlin;
- /*< l3=l2+ntlin >*/
- l3 = l2 + cirdat_1.ntlin;
- /*< t1=value(l1+1) >*/
- t1 = blank_1.value[l1];
- /*< t2=value(l2+1) >*/
- t2 = blank_1.value[l2];
- /*< 620 t3=value(l3+1) >*/
- L620:
- t3 = blank_1.value[l3];
- /*< icntr=icntr+1 >*/
- ++icntr;
- /*< if (baktim.le.t3) go to 630 >*/
- if (baktim <= t3) {
- goto L630;
- }
- /*< if (icntr.eq.numtd) go to 900 >*/
- if (icntr == numtd) {
- goto L900;
- }
- /*< l1=l2 >*/
- l1 = l2;
- /*< l2=l3 >*/
- l2 = l3;
- /*< l3=l2+ntlin >*/
- l3 = l2 + cirdat_1.ntlin;
- /*< t1=t2 >*/
- t1 = t2;
- /*< t2=t3 >*/
- t2 = t3;
- /*< go to 620 >*/
- goto L620;
- /*< 630 dt1t2=t1-t2 >*/
- L630:
- dt1t2 = t1 - t2;
- /*< dt1t3=t1-t3 >*/
- dt1t3 = t1 - t3;
- /*< dt2t3=t2-t3 >*/
- dt2t3 = t2 - t3;
- /*< tdnom1=1.0d0/(dt1t2*dt1t3) >*/
- tdnom1 = 1. / (dt1t2 * dt1t3);
- /*< tdnom2=-1.0d0/(dt1t2*dt2t3) >*/
- tdnom2 = -1. / (dt1t2 * dt2t3);
- /*< tdnom3=1.0d0/(dt2t3*dt1t3) >*/
- tdnom3 = 1. / (dt2t3 * dt1t3);
- /*< dtt1=baktim-t1 >*/
- dtt1 = baktim - t1;
- /*< dtt2=baktim-t2 >*/
- dtt2 = baktim - t2;
- /*< dtt3=baktim-t3 >*/
- dtt3 = baktim - t3;
- /*< tfact1=dtt2*dtt3*tdnom1 >*/
- tfact1 = dtt2 * dtt3 * tdnom1;
- /*< tfact2=dtt1*dtt3*tdnom2 >*/
- tfact2 = dtt1 * dtt3 * tdnom2;
- /*< tfact3=dtt1*dtt2*tdnom3 >*/
- tfact3 = dtt1 * dtt2 * tdnom3;
- /*< value(locv+3)=value(l1+ltdptr+0)*tfact1+value(l2+ltdptr+0)*tfact2 >*/
- /*< 1 +value(l3+ltdptr+0)*tfact3 >*/
- blank_1.value[locv + 2] = blank_1.value[l1 + ltdptr - 1] * tfact1 +
- blank_1.value[l2 + ltdptr - 1] * tfact2 + blank_1.value[l3 +
- ltdptr - 1] * tfact3;
- /*< value(locv+4)=value(l1+ltdptr+1)*tfact1+value(l2+ltdptr+1)*tfact2 >*/
- /*< 1 +value(l3+ltdptr+1)*tfact3 >*/
- blank_1.value[locv + 3] = blank_1.value[l1 + ltdptr] * tfact1 +
- blank_1.value[l2 + ltdptr] * tfact2 + blank_1.value[l3 + ltdptr] *
- tfact3;
- /*< 640 loc=nodplc(loc) >*/
- L640:
- loc = nodplc[loc - 1];
- /*< go to 610 >*/
- goto L610;
-
- /* internal logic error: less than 3 entries in ltd */
-
- /*< 900 nogo=1 >*/
- L900:
- flags_1.nogo = 1;
- /*< write (iofile,901) numtd,icntr >*/
- io__45.ciunit = status_1.iofile;
- s_wsfe(&io__45);
- do_fio(&c__1, (char *)&numtd, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&icntr, (ftnlen)sizeof(integer));
- e_wsfe();
- /*< 901 format('0*abort*: internal spice error: sorupd: ',2i5/) >*/
-
- /* finished */
-
- /*< 1000 return >*/
- L1000:
- return 0;
- /*< end >*/
- } /* sorupd_ */
-
- #undef cvalue
- #undef nodplc
-
-
-